DEFINT A-Z
DIM SHARED N(4) AS INTEGER,P(24,4) AS INTEGER,M(99,113) AS INTEGER
DIM SHARED BM(16) AS INTEGER
COMMON SHARED FTMP$,FTMP2$,FRES$,GOALMAX,PL,IP,IDX,IDXMAX
FTMP$="24STAT.TMP":FTMP2$="24STAT.BSV":FRES$="24STAT.CSV"
NMAX=13:IDXMAX=1820:GOALMAX=99:IDX=0:IP=0:PL=0:ACT=0
FOR I=0 TO 14:BM(I)=2^I:NEXT I:BM(15)=&H8000
FOR I=0 TO 3:N(I)=1:FOR J=0 TO 3
  IF I<>J THEN
    FOR K=0 TO 3
      IF I<>K AND J<>K THEN
        P(PL,0)=I:P(PL,1)=J:P(PL,2)=K:P(PL,3)=6-I-J-K
	PL=PL+1
      END IF
    NEXT K
  END IF
NEXT J:NEXT I

ON ERROR GOTO ErrorHandler
OPEN FTMP$ FOR INPUT AS #1
ON ERROR GOTO 0
IF ACT=0 THEN
  INPUT #1,N(0),N(1),N(2),N(3),IP,IDX
  CLOSE #1
  DEF SEG=VARSEG(M(0,0)):BLOAD FTMP2$,VARPTR(M(0,0)):DEF SEG
ELSE
  ACT=0
END IF

PRINT "Press any key to exit with current progress saved"
PRINT USING "Processed: ####/#### ###.#%  ";IDX,IDXMAX,CDBL(IDX)*100/IDXMAX;
MOF=IDX\16:MMASK=BM(IDX AND 15)
T0#=TIMER
WHILE N(0)<=NMAX
  CALL CALC24(N(),IP,MOF,MMASK)
  IP=IP+1
  IF IP>=PL THEN
    N(3)=N(3)+1
    IF N(3)>NMAX THEN
      N(2)=N(2)+1
      IF N(2)>NMAX THEN
        N(1)=N(1)+1
        IF N(1)>NMAX THEN
          N(0)=N(0)+1
          N(1)=N(0)
        END IF
        N(2)=N(1)
      END IF
      N(3)=N(2)
    END IF
    IP=0
    IDX=IDX+1
    MOF=IDX\16:MMASK=BM(IDX AND 15)
    LOCATE ,1
    PRINT USING "Processed: ####/#### ###.#%  ";IDX,IDXMAX,CDBL(IDX)*100/IDXMAX;
  END IF
  IF INKEY$<>"" THEN PRINT "":CALL SNAPSHOT:END
  T#=TIMER
  IF T#<T0# OR T#-T0#>120 THEN T0#=T#:CALL SNAPSHOT
WEND
PRINT ""
OPEN FRES$ FOR OUTPUT AS #1
PRINT #1,"Goal,Solvable In "+LTRIM$(RTRIM$(STR$(IDXMAX)))
FOR G=0 TO GOALMAX
  PRINT #1,LTRIM$(RTRIM$(STR$(G)));",";LTRIM$(RTRIM$(STR$(COUNTRES(G))))
NEXT G
CLOSE #1
ON ERROR GOTO ErrorHandler
KILL FTMP$
KILL FTMP2$
ON ERROR GOTO 0
END

ErrorHandler:
ACT=2:RESUME NEXT

SUB SNAPSHOT
  OPEN FTMP$ FOR OUTPUT AS #1
  PRINT #1,N(0);N(1);N(2);N(3);IP;IDX
  CLOSE #1
  DEF SEG=VARSEG(M(0,0)):BSAVE FTMP2$,VARPTR(M(0,0)),100*114*2:DEF SEG
END SUB

SUB CALC24(N() AS INTEGER,I AS INTEGER,OF AS INTEGER,MASK AS INTEGER):
  FOR OP0=0 TO 3:FOR OP1=0 TO 3:FOR OP2=0 TO 3
    A#=N(P(I,0)):B#=N(P(I,1)):C#=N(P(I,2)):D#=N(P(I,3))

    REM abcd### a#(b#(c#d))
    R#=CALC#(A#,OP0,CALC#(B#,OP1,CALC#(C#,OP2,D#)))
    CALL WRITERES(R#,OF,MASK)

    REM abc#d## a#((b#c)#d)
    R#=CALC#(A#,OP0,CALC#(CALC#(B#,OP1,C#),OP2,D#))
    CALL WRITERES(R#,OF,MASK)

    REM abc##d# (a#(b#c))#d
    R#=CALC#(CALC#(A#,OP0,CALC#(B#,OP1,C#)),OP2,D#)
    CALL WRITERES(R#,OF,MASK)

    REM ab#cd## (a#b)#(c#d)
    R#=CALC#(CALC#(A#,OP0,B#),OP1,CALC#(C#,OP2,D#))
    CALL WRITERES(R#,OF,MASK)

    REM ab#c#d# ((a#b)#c)#d
    R#=CALC#(CALC#(CALC#(A#,OP0,B#),OP1,C#),OP2,D#)
    CALL WRITERES(R#,OF,MASK)
  NEXT OP2:NEXT OP1:NEXT OP0
END SUB

SUB WRITERES(R AS DOUBLE,OF AS INTEGER,MASK AS INTEGER)
  DIM N AS INTEGER
  IF R<-0.001 OR R>GOALMAX+0.001 THEN EXIT SUB
  N=CINT(R)
  IF ABS(R-N)>0.00001 THEN EXIT SUB
  M(N,OF)=M(N,OF) OR MASK
END SUB

FUNCTION CALC#(X AS DOUBLE,OP AS INTEGER,Y AS DOUBLE)
  IF X>=1000000 OR Y>=1000000 THEN CALC#=10000000:EXIT FUNCTION
  SELECT CASE OP
    CASE 0
      CALC#=X+Y
    CASE 1
      CALC#=X-Y
    CASE 2
      CALC#=X*Y
    CASE 3
      IF Y=0 THEN CALC#=10000000 ELSE CALC#=X/Y
  END SELECT
END FUNCTION

FUNCTION COUNTRES(G AS INTEGER)
  DIM BM AS INTEGER
  N=0
  FOR I=0 TO 113
    BM=M(G,I)
    IF (BM AND &H8000)<>0 THEN N=N+1:BM=BM AND &H7FFF
    WHILE BM<>0
      BM=BM AND (BM-1):N=N+1
    WEND
  NEXT I
  COUNTRES=N
END FUNCTION

